home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SWAG / SWAGA_C / COMM.SWG / 0009_ASYNC Routines.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  29KB  |  781 lines
  1. {
  2. >doors. But, i have one little problem: I don't know how to hang-up the modem
  3. >- I am using a ready-made TPU that does all the port tasks, but it just can'
  4. >hang up!
  5.  
  6. Here is some code I pulled out of this conference a While ago:
  7. }
  8.  
  9. Unit EtAsync;
  10.  
  11. {****************************************************************************}
  12. {* EtAsync V.1.04, 9/4 1992 Et-Soft                                         *}
  13. {*                                                                          *}
  14. {* Turbo Pascal Unit With support For up to 8 serial ports.                 *}
  15. {****************************************************************************}
  16.  
  17. {$A-}                              {- Word alignment -}
  18. {$B-}                              {- Complete Boolean evaluation -}
  19. {$D-}                              {- Debug inFormation -}
  20. {$E-}                              {- Coprocessor emulation -}
  21. {$F+}                              {- Force Far calls -}
  22. {$I-}                              {- I/O checking -}
  23. {$L-}                              {- Local debug symbols -}
  24. {$N-}                              {- Coprocessor code generation -}
  25. {$O-}                              {- Overlayes allowed -}
  26. {$R-}                              {- Range checking -}
  27. {$S-}                              {- Stack checking -}
  28. {$V-}                              {- Var-String checking -}
  29. {$M 16384,0,655360}                {- Stack size, min heap, max heap -}
  30. {****************************************************************************}
  31.                                    Interface
  32. {****************************************************************************}
  33. Uses
  34.   Dos;
  35. {****************************************************************************}
  36.   {- Standard baudrates: -}
  37.   {- 50, 75, 110, 134 (134.5), 150, 300, 600, 1200, 1800, 2000, 2400, 3600, -}
  38.   {- 4800, 7200, 9600, 19200, 38400, 57600, 115200 -}
  39.  
  40. Function OpenCOM            {- Open a COMport For communication -}
  41.   (Nr         : Byte;       {- Internal portnumber: 0-7 -}
  42.    Address    : Word;       {- Port address in hex: 000-3F8 -}
  43.    IrqNum     : Byte;       {- Port Irq number: 0-7  (255 For no Irq) -}
  44.    Baudrate   : LongInt;    {- Baudrate: (see table) -}
  45.    ParityBit  : Char;       {- Parity  : 'O','E' or 'N' -}
  46.    Databits   : Byte;       {- Databits: 5-8 -}
  47.    Stopbits   : Byte;       {- Stopbits: 1-2 -}
  48.    BufferSize : Word;       {- Size of input buffer: 0-65535 -}
  49.    Handshake  : Boolean)    {- True to use hardware handshake -}
  50.      : Boolean;             {- Returns True if ok -}
  51.  
  52. Procedure CloseCOM          {- Close a open COMport -}
  53.   (Nr : Byte);              {- Internal portnumber: 0-7 -}
  54.  
  55. Procedure ResetCOM          {- Reset a open COMport incl. buffer -}
  56.   (Nr : Byte);              {- Internal portnumber: 0-7 -}
  57.  
  58. Procedure COMSettings       {- Change settings For a open COMport -}
  59.   (Nr        : Byte;        {- Internal portnumber: 0-7 -}
  60.    Baudrate  : LongInt;     {- Baudrate: (see table) -}
  61.    Paritybit : Char;        {- Parity  : 'O','E' or 'N' -}
  62.    Databits  : Byte;        {- Databits: 5-8 -}
  63.    Stopbits  : Byte;        {- Stopbits: 1-2 -}
  64.    Handshake : Boolean);    {- True to use hardware handshake -}
  65.  
  66. Function COMAddress         {- Return the address For a COMport (BIOS) -}
  67.   (COMport : Byte)          {- COMport: 1-8 -}
  68.     : Word;                 {- Address found For COMport (0 if none) -}
  69.  
  70. Function WriteCOM           {- Writes a Character to a port -}
  71.   (Nr : Byte;               {- Internal portnumber: 0-7 -}
  72.    Ch : Char)               {- Character to be written to port -}
  73.     : Boolean;              {- True if Character send -}
  74.  
  75. Function WriteCOMString     {- Writes a String to a port -}
  76.   (Nr : Byte;               {- Internal portnumber: 0-7 -}
  77.    St : String)             {- String to be written to port -}
  78.     : Boolean;              {- True if String send -}
  79.  
  80. Function CheckCOM           {- Check if any Character is arrived -}
  81.   (Nr : Byte;               {- Internal portnumber: 0-7 -}
  82.    Var Ch : Char)           {- Character arrived -}
  83.     : Boolean;              {- Returns True and Character if any -}
  84.  
  85. Function COMError           {- Returns status of the last operation -}
  86.     : Integer;              {- 0 = Ok -}
  87.                             {- 1 = not enough memory -}
  88.                             {- 2 = Port not open -}
  89.                             {- 3 = Port already used once -}
  90.                             {- 4 = Selected Irq already used once -}
  91.                             {- 5 = Invalid port -}
  92.                             {- 6 = Timeout -}
  93.                             {- 7 = Port failed loopback test -}
  94.                             {- 8 = Port failed IRQ test -}
  95.  
  96. Function TestCOM            {- PerForms a loopback and IRQ test on a port -}
  97.   (Nr : Byte)               {- Internal port number: 0-7 -}
  98.     : Boolean;              {- True if port test ok -}
  99.                             {- note: This is perFormed during OpenCOM -}
  100.                             {- if enabled (TestCOM is by default enabled -}
  101.                             {- during OpenCOM, but can be disabled With -}
  102.                             {- the DisableTestCOM routine) -}
  103.  
  104. Procedure EnableTestCOM;    {- Enable TestCOM during Openport (Default On) }
  105.  
  106. Procedure DisableTestCOM;   {- Disable TestCOM during Openport -}
  107.  
  108. Function COMUsed            {- Check whether or not a port is open -}
  109.   (Nr : Byte)               {- Internal port number: 0-7 -}
  110.     : Boolean;              {- True if port is open and in use -}
  111.                             {- note: This routine can not test -}
  112.                             {- whether or not a COMport is used by
  113.                             {- another application -}
  114.  
  115. Function IrqUsed            {- Check whether or not an Irq is used -}
  116.   (IrqNum : Byte)           {- Irq number: 0-7 -}
  117.     : Boolean;              {- True if Irq is used -}
  118.                             {- note: This routine can not test -}
  119.                             {- whether or not an IRQ is used by -}
  120.                             {- another application -}
  121.  
  122. Function IrqInUse           {- Test IRQ in use on the PIC -}
  123.   (IrqNum : Byte)           {- Irq number: 0-7 -}
  124.     : Boolean;              {- True if Irq is used -}
  125.  
  126. Procedure SetIrqPriority    {- Set the Irq priority level on the PIC -}
  127.   (IrqNum : Byte);          {- Irq number: 0-7 -}
  128.                             {- The IrqNum specified will get the highest -}
  129.                             {- priority, the following Irq number will
  130.                             {- then have the next highest priority -}
  131.                             {- and so on -}
  132.  
  133. Procedure ClearBuffer       {- Clear the input buffer For a open port -}
  134.   (Nr : Byte);              {- Internal port number: 0-7 -}
  135.  
  136.  
  137. {****************************************************************************}
  138.                                  Implementation
  139. {****************************************************************************}
  140. Type
  141.   Buffer = Array[1..65535] of Byte;  {- Dummy Type For Interrupt buffer -}
  142.   PortRec = Record                   {- Portdata Type -}
  143.     InUse   : Boolean;               {- True if port is used -}
  144.     Addr    : Word;                  {- Selected address -}
  145.     Irq     : Byte;                  {- Selected Irq number -}
  146.     OldIrq  : Byte;                  {- Status of Irq beFore InitCOM -}
  147.     HShake  : Boolean;               {- Hardware handshake on/off -}
  148.     Buf     : ^Buffer;               {- Pointer to allocated buffer -}
  149.     BufSize : Word;                  {- Size of allocated buffer -}
  150.     OldVec  : Pointer;               {- Saved old interrupt vector -}
  151.     Baud    : LongInt;               {- Selected baudrate -}
  152.     Parity  : Char;                  {- Selected parity -}
  153.     Databit : Byte;                  {- Selected number of databits -}
  154.     Stopbit : Byte;                  {- Selected number of stopbits -}
  155.     InPtr   : Word;                  {- Pointer to buffer input index -}
  156.     OutPtr  : Word;                  {- Pointer to buffer output index -}
  157.     Reg0    : Byte;                  {- Saved UART register 0 -}
  158.     Reg1    : Array[1..2] of Byte;   {- Saved UART register 1's -}
  159.     Reg2    : Byte;                  {- Saved UART register 2 -}
  160.     Reg3    : Byte;                  {- Saved UART register 3 -}
  161.     Reg4    : Byte;                  {- Saved UART register 4 -}
  162.     Reg6    : Byte;                  {- Saved UART register 6 -}
  163.   end;
  164.  
  165. Var
  166.   COMResult   : Integer;                    {- Last Error (Call COMError) -}
  167.   ExitChainP  : Pointer;                    {- Saved Exitproc Pointer -}
  168.   OldPort21   : Byte;                       {- Saved PIC status -}
  169.   Ports       : Array[0..7] of PortRec;     {- The 8 ports supported -}
  170.  
  171. Const
  172.   PIC = $20;                                {- PIC control address -}
  173.   EOI = $20;                                {- PIC control Byte -}
  174.   TestCOMEnabled : Boolean = True;          {- Test port during OpenCOM -}
  175.  
  176. {****************************************************************************}
  177. Procedure DisableInterrupts;                {- Disable interrupt -}
  178. begin
  179.   Inline($FA);                            {- CLI (Clear Interruptflag) -}
  180. end;
  181. {****************************************************************************}
  182. Procedure EnableInterrupts;                 {- Enable interrupts -}
  183. begin
  184.   Inline($FB);                            {- STI (Set interrupt flag) -}
  185. end;
  186. {****************************************************************************}
  187. Procedure Port0Int; Interrupt;              {- Interrupt rutine port 0 -}
  188. begin
  189.   With Ports[0] Do
  190.   begin
  191.     Buf^[InPtr] := Port[Addr];             {- Read data from port -}
  192.     Inc(InPtr);                            {- Count one step Forward.. }
  193.     if InPtr > BufSize then
  194.       InPtr := 1;    {  .. in buffer -}
  195.   end;
  196.   Port[PIC] := EOI;                          {- Send EOI to PIC -}
  197. end;
  198. {****************************************************************************}
  199. Procedure Port1Int; Interrupt;                 {- Interrupt rutine port 1 -}
  200. begin
  201.   With Ports[1] Do
  202.   begin
  203.     Buf^[InPtr] := Port[Addr];             {- Read data from port -}
  204.     Inc(InPtr);                            {- Count one step Forward.. }
  205.     if InPtr > BufSize then
  206.       InPtr := 1;    {  .. in buffer -}
  207.   end;
  208.   Port[PIC] := EOI;                          {- Send EOI to PIC -}
  209. end;
  210. {****************************************************************************}
  211. Procedure Port2Int; Interrupt;                 {- Interrupt rutine port 2 -}
  212. begin
  213.   With Ports[2] Do
  214.   begin
  215.     Buf^[InPtr] := Port[Addr];             {- Read data from port -}
  216.     Inc(InPtr);                            {- Count one step Forward.. }
  217.     if InPtr > BufSize then
  218.       InPtr := 1;    {  .. in buffer -}
  219.   end;
  220.   Port[PIC] := EOI;                          {- Send EOI to PIC -}
  221. end;
  222. {****************************************************************************}
  223. Procedure Port3Int; Interrupt;                 {- Interrupt rutine port 3 -}
  224. begin
  225.   With Ports[3] Do
  226.   begin
  227.     Buf^[InPtr] := Port[Addr];            {- Read data from port -}
  228.     Inc(InPtr);                           {- Count one step Forward.. }
  229.     if InPtr > BufSize then
  230.       InPtr := 1;   {  .. in buffer -}
  231.   end;
  232.   Port[PIC] := EOI;                         {- Send EOI to PIC -}
  233. end;
  234. {****************************************************************************}
  235. Procedure Port4Int; Interrupt;                {- Interrupt rutine port 4 -}
  236. begin
  237.   With Ports[4] Do
  238.   begin
  239.     Buf^[InPtr] := Port[Addr];            {- Read data from port -}
  240.     Inc(InPtr);                           {- Count one step Forward.. }
  241.     if InPtr > BufSize then
  242.       InPtr := 1;   {  .. in buffer -}
  243.   end;
  244.   Port[PIC] := EOI;                         {- Send EOI to PIC -}
  245. end;
  246. {****************************************************************************}
  247. Procedure Port5Int; Interrupt;                {- Interrupt rutine port 5 -}
  248. begin
  249.   With Ports[5] Do
  250.   begin
  251.     Buf^[InPtr] := Port[Addr];            {- Read data from port -}
  252.     Inc(InPtr);                           {- Count one step Forward.. }
  253.     if InPtr > BufSize then
  254.       InPtr := 1;   {  .. in buffer -}
  255.   end;
  256.   Port[PIC] := EOI;                         {- Send EOI to PIC -}
  257. end;
  258. {****************************************************************************}
  259. Procedure Port6Int; Interrupt;                {- Interrupt rutine port 6 -}
  260. begin
  261.   With Ports[6] Do
  262.   begin
  263.     Buf^[InPtr] := Port[Addr];            {- Read data from port -}
  264.     Inc(InPtr);                           {- Count one step Forward.. }
  265.     if InPtr > BufSize then
  266.       InPtr := 1;   {  .. in buffer -}
  267.   end;
  268.   Port[PIC] := EOI;                         {- Send EOI to PIC -}
  269. end;
  270. {****************************************************************************}
  271. Procedure Port7Int; Interrupt;                {- Interrupt rutine port 7 -}
  272. begin
  273.   With Ports[7] Do
  274.   begin
  275.     Buf^[InPtr] := Port[Addr];            {- Read data from port-}
  276.     Inc(InPtr);                           {- Count one step Forward..}
  277.     if InPtr > BufSize then
  278.       InPtr := 1;   {  .. in buffer-}
  279.   end;
  280.   Port[PIC] := EOI;                         {- Send EOI to PIC-}
  281. end;
  282. {****************************************************************************}
  283. Procedure InitPort(Nr : Byte; SaveStatus : Boolean);     {- Port initialize -}
  284.  
  285. Var
  286.   divider  : Word;                               {- Baudrate divider number -}
  287.   CtrlBits : Byte;                                     {- UART control Byte -}
  288.  
  289. begin
  290.   With Ports[Nr] Do
  291.   begin
  292.     divider := 115200 div Baud;                {- Calc baudrate divider -}
  293.  
  294.     CtrlBits := DataBit - 5;                    {- Insert databits -}
  295.  
  296.     if Parity <> 'N' then
  297.     begin
  298.       CtrlBits := CtrlBits or $08;            {- Insert parity enable -}
  299.       if Parity = 'E' then                    {- Enable even parity -}
  300.         CtrlBits := CtrlBits or $10;
  301.     end;
  302.  
  303.     if Stopbit = 2 then
  304.       CtrlBits := CtrlBits or $04;              {- Insert stopbits -}
  305.  
  306.     if SaveStatus then
  307.       Reg3 := Port[Addr + $03];    {- Save register 3 -}
  308.     Port[Addr + $03] := $80;                        {- Baudrate change -}
  309.  
  310.     if SaveStatus then
  311.       Reg0 := Port[Addr + $00];    {- Save Lo Baud -}
  312.     Port[Addr + $00] := Lo(divider);                {- Set Lo Baud -}
  313.  
  314.     if SaveStatus then
  315.       Reg1[2] := Port[Addr + $01]; {- Save Hi Baud -}
  316.     Port[Addr + $01] := Hi(divider);                {- Set Hi Baud -}
  317.  
  318.     Port[Addr + $03] := CtrlBits;                   {- Set control reg. -}
  319.     if SaveStatus then
  320.       Reg6 := Port[Addr + $06];    {- Save register 6 -}
  321.   end;
  322. end;
  323. {****************************************************************************}
  324. Function IrqUsed(IrqNum : Byte) : Boolean;
  325.  
  326. Var
  327.   Count : Byte;
  328.   Found : Boolean;
  329.  
  330. begin
  331.   Found := False;                                 {- Irq not found -}
  332.   Count := 0;                                     {- Start With port 0 -}
  333.  
  334.   While (Count <= 7) and not Found Do             {- Count the 8 ports -}
  335.     With Ports[Count] Do
  336.     begin
  337.       if InUse then
  338.         Found := IrqNum = Irq;                  {- Check Irq match -}
  339.       Inc(Count);                               {- Next port -}
  340.     end;
  341.  
  342.   IrqUsed := Found;                               {- Return Irq found -}
  343. end;
  344. {****************************************************************************}
  345. Procedure EnableTestCOM;
  346. begin
  347.   TestCOMEnabled := True;
  348. end;
  349. {****************************************************************************}
  350. Procedure DisableTestCOM;
  351. begin
  352.   TestCOMEnabled := False;
  353. end;
  354. {****************************************************************************}
  355. Function TestCOM(Nr : Byte) : Boolean;
  356.  
  357. Var
  358.   OldReg0   : Byte;
  359.   OldReg1   : Byte;
  360.   OldReg4   : Byte;
  361.   OldReg5   : Byte;
  362.   OldReg6   : Byte;
  363.   OldInPtr  : Word;
  364.   OldOutPtr : Word;
  365.   TimeOut   : Integer;
  366.  
  367.   begin
  368.  
  369.   TestCOM := False;
  370.  
  371.   With Ports[Nr] Do
  372.   begin
  373.     if InUse then
  374.     begin
  375.       OldInPtr  := InPtr;
  376.       OldOutPtr := OutPtr;
  377.       OldReg1 := Port[Addr + $01];
  378.       OldReg4 := Port[Addr + $04];
  379.       OldReg5 := Port[Addr + $05];
  380.       OldReg6 := Port[Addr + $06];
  381.  
  382.       Port[Addr + $05] := $00;
  383.       Port[Addr + $04] := Port[Addr + $04] or $10;
  384.  
  385.       OldReg0 := Port[Addr + $00];
  386.       OutPtr  := InPtr;
  387.  
  388.       TimeOut := MaxInt;
  389.       Port[Addr + $00] := OldReg0;
  390.  
  391.       While (Port[Addr + $05] and $01 = $00) and (TimeOut <> 0) Do
  392.         Dec(TimeOut);
  393.  
  394.       if TimeOut <> 0 then
  395.       begin
  396.         if Port[Addr + $00] = OldReg0 then
  397.         begin
  398.           if IRQ In [0..7] then
  399.           begin
  400.             TimeOut := MaxInt;
  401.             OutPtr := InPtr;
  402.  
  403.             Port[Addr + $01] := $08;
  404.             Port[Addr + $04] := $08;
  405.             Port[Addr + $06] := Port[Addr + $06] or $01;
  406.  
  407.             While (InPtr = OutPtr) and (TimeOut <> 0) Do
  408.               Dec(TimeOut);
  409.  
  410.             Port[Addr + $01] := OldReg1;
  411.  
  412.             if (InPtr <> OutPtr) then
  413.               TestCOM := True
  414.             else
  415.               COMResult := 8;
  416.           end
  417.           else
  418.             TestCOM := True;
  419.         end
  420.         else
  421.           COMResult := 7;            {- Loopback test failed -}
  422.       end
  423.       else
  424.         COMResult := 6;                {- Timeout -}
  425.  
  426.       Port[Addr + $04] := OldReg4;
  427.       Port[Addr + $05] := OldReg5;
  428.       Port[Addr + $06] := OldReg6;
  429.  
  430.       For TimeOut := 1 to MaxInt Do;
  431.       if Port[Addr + $00] = 0 then;
  432.  
  433.       InPtr  := OldInPtr;
  434.       OutPtr := OldOutPtr;
  435.     end
  436.     else
  437.       COMResult := 2;                    {- Port not open -}
  438.   end;
  439. end;
  440. {****************************************************************************}
  441. Procedure CloseCOM(Nr : Byte);
  442.  
  443. begin
  444.   With Ports[Nr] Do
  445.   begin
  446.     if InUse then
  447.     begin
  448.       InUse := False;
  449.  
  450.       if Irq <> 255 then                         {- if Interrupt used -}
  451.       begin
  452.         FreeMem(Buf,BufSize);                  {- Deallocate buffer -}
  453.         DisableInterrupts;
  454.         Port[$21] := Port[$21] or ($01 Shl Irq) and OldIrq;
  455. {-restore-}
  456.         Port[Addr + $04] := Reg4;              {- Disable UART OUT2 -}
  457.         Port[Addr + $01] := Reg1[1];           {- Disable UART Int. -}
  458.         SetIntVec($08+Irq,OldVec);            {- Restore Int.Vector -}
  459.         EnableInterrupts;
  460.       end;
  461.  
  462.       Port[Addr + $03] := $80;                    {- UART Baud set -}
  463.       Port[Addr + $00] := Reg0;                   {- Reset Lo Baud -}
  464.       Port[Addr + $01] := Reg1[2];                {- Reset Hi Baud -}
  465.       Port[Addr + $03] := Reg3;                {- Restore UART ctrl. -}
  466.       Port[Addr + $06] := Reg6;                  {- Restore UART reg6 -}
  467.     end
  468.     else
  469.       COMResult := 2;                               {- Port not in use -}
  470.   end;
  471. end;
  472. {****************************************************************************}
  473. Function OpenCOM
  474.  (Nr : Byte; Address  : Word; IrqNum : Byte; Baudrate : LongInt;
  475.   ParityBit : Char; Databits, Stopbits : Byte; BufferSize : Word;
  476.   HandShake : Boolean) : Boolean;
  477.  
  478. Var
  479.   IntVec : Pointer;
  480.   OldErr : Integer;
  481.  
  482. begin
  483.   OpenCOM := False;
  484.  
  485.   if (IrqNum = 255) or
  486.   ((IrqNum In [0..7]) and (MaxAvail >= LongInt(BufferSize))
  487.                       and not IrqUsed(IrqNum)) then
  488.     With Ports[Nr] Do
  489.     begin
  490.       if not InUse and (Address <= $3F8) then
  491.       begin
  492.         InUse   := True;                    {- Port now in use -}
  493.  
  494.         Addr    := Address;                 {- Save parameters -}
  495.         Irq     := IrqNum;
  496.         HShake  := HandShake;
  497.         BufSize := BufferSize;
  498.         Baud    := Baudrate;
  499.         Parity  := Paritybit;
  500.         Databit := Databits;
  501.         Stopbit := Stopbits;
  502.  
  503.         InPtr   := 1;                       {- Reset InputPointer -}
  504.         OutPtr  := 1;                       {- Reset OutputPointer -}
  505.  
  506.         if (Irq In [0..7]) and (BufSize > 0) then
  507.         begin
  508.           GetMem(Buf,BufSize);            {- Allocate buffer -}
  509.           GetIntVec($08+Irq,OldVec);      {- Save Interrupt vector -}
  510.  
  511.           Case Nr of                    {- Find the interrupt proc. -}
  512.             0 : IntVec := @Port0Int;
  513.             1 : IntVec := @Port1Int;
  514.             2 : IntVec := @Port2Int;
  515.             3 : IntVec := @Port3Int;
  516.             4 : IntVec := @Port4Int;
  517.             5 : IntVec := @Port5Int;
  518.             6 : IntVec := @Port6Int;
  519.             7 : IntVec := @Port7Int;
  520.           end;
  521.  
  522.           Reg1[1] := Port[Addr + $01];    {- Save register 1 -}
  523.           Reg4    := Port[Addr + $04];    {- Save register 4 -}
  524.           OldIrq  := Port[$21] or not ($01 Shl Irq);{- Save PIC Irq -}
  525.  
  526.           DisableInterrupts;              {- Disable interrupts -}
  527.           SetIntVec($08+Irq,IntVec);    {- Set the interrupt vector -}
  528.           Port[Addr + $04] := $08;        {- Enable OUT2 on port -}
  529.           Port[Addr + $01] := $01;      {- Set port data avail.int. -}
  530.           Port[$21] := Port[$21] and not ($01 Shl Irq);{- Enable Irq-}
  531.           EnableInterrupts;         {- Enable interrupts again -}
  532.         end;
  533.         InitPort(Nr,True);                  {- Initialize port -}
  534.  
  535.         if TestCOMEnabled then
  536.         begin
  537.           if not TestCOM(Nr) then
  538.           begin
  539.             OldErr := COMResult;
  540.             CloseCOM(Nr);
  541.             COMResult := OldErr;
  542.           end
  543.           else
  544.             OpenCOM := True;
  545.         end
  546.         else
  547.           OpenCOM := True;
  548.  
  549.         if Port[Addr + $00] = 0 then;  {- Remove any pending Character-}
  550.         if Port[Addr + $05] = 0 then;  {- Reset line status register-}
  551.  
  552.         Port[Addr + $04] := Port[Addr + $04] or $01;     {- Enable DTR-}
  553.       end
  554.       else if InUse then
  555.         COMResult := 3                        {- Port already in use-}
  556.       else if (Address > $3F8) then
  557.         COMResult := 5;                       {- Invalid port address-}
  558.     end
  559.   else if (MaxAvail >= BufferSize) then         {- not enough memory-}
  560.     COMResult := 1
  561.   else if IrqUsed(IrqNum) then                  {- Irq already used -}
  562.     COMResult := 4;
  563. end;
  564. {****************************************************************************}
  565. Procedure ResetCOM(Nr : Byte);
  566.  
  567. begin
  568.   With Ports[Nr] Do
  569.   begin
  570.     if InUse then                        {- Is port defined ?-}
  571.     begin
  572.       InPtr  := 1;                     {- Reset buffer Pointers-}
  573.       OutPtr := 1;
  574.       InitPort(Nr,False);              {- Reinitialize the port-}
  575.  
  576.       if Port[Addr + $00] = 0 then;    {- Remove any pending Character-}
  577.       if Port[Addr + $05] = 0 then;    {- Reset line status register-}
  578.     end
  579.     else
  580.       COMResult := 2;                    {- Port not open-}
  581.   end;
  582. end;
  583. {****************************************************************************}
  584. Procedure COMSettings(Nr : Byte; Baudrate : LongInt; ParityBit : Char;
  585.   Databits, Stopbits : Byte; HandShake : Boolean);
  586. begin
  587.   With Ports[Nr] Do
  588.   begin
  589.     if InUse then                                     {- Is port in use-}
  590.     begin
  591.       Baud    := Baudrate;                          {- Save parameters-}
  592.       Parity  := Paritybit;
  593.       Databit := Databits;
  594.       Stopbit := Stopbits;
  595.       HShake  := HandShake;
  596.  
  597.       InitPort(Nr,False);                           {- ReInit port-}
  598.     end
  599.     else
  600.       COMResult := 2;                                 {- Port not in use-}
  601.   end;
  602. end;
  603. {****************************************************************************}
  604. Function COMAddress(COMport : Byte) : Word;
  605.  
  606. begin
  607.   if Comport In [1..8] then
  608.     COMAddress := MemW[$40:(Pred(Comport) Shl 1)]       {- BIOS data table-}
  609.   else
  610.     COMResult := 5;                                     {- Invalid port-}
  611. end;
  612. {****************************************************************************}
  613. Function WriteCOM(Nr : Byte; Ch : Char) : Boolean;
  614.  
  615. Var
  616.   Count : Integer;
  617.  
  618. begin
  619.   WriteCom := True;
  620.  
  621.   With Ports[Nr] Do
  622.     if InUse then
  623.     begin
  624.       While Port[Addr + $05] and $20 = $00 Do;   {- Wait Until Char send-}
  625.       if not HShake then
  626.         Port[Addr] := ord(Ch)                    {- Send Char to port-}
  627.       else
  628.       begin
  629.         Port[Addr + $04] := $0B;               {- OUT2, DTR, RTS-}
  630.         Count := MaxInt;
  631.  
  632.         While (Port[Addr + $06] and $10 = 0) and (Count <> 0) Do
  633.           Dec(Count);                          {- Wait For CTS-}
  634.  
  635.         if Count <> 0 then                     {- if not timeout-}
  636.           Port[Addr] := ord(Ch)                {- Send Char to port-}
  637.         else
  638.         begin
  639.           COMResult := 6;                    {- Timeout error-}
  640.           WriteCom  := False;
  641.         end;
  642.       end;
  643.     end
  644.     else
  645.     begin
  646.       COMResult := 2;                            {- Port not in use-}
  647.       WriteCom  := False;
  648.     end;
  649. end;
  650. {****************************************************************************}
  651. Function WriteCOMString(Nr : Byte; St : String) : Boolean;
  652.  
  653. Var
  654.   Ok : Boolean;
  655.   Count : Byte;
  656.  
  657. begin
  658.   if Length(St) > 0 then                           {- Any Chars to send ?-}
  659.   begin
  660.     Ok    := True;
  661.     Count := 1;
  662.     While (Count <= Length(St)) and Ok Do        {- Count Chars-}
  663.     begin
  664.       Ok := WriteCOM(Nr,St[Count]);            {- Send Char-}
  665.       Inc(Count);                              {- Next Character-}
  666.     end;
  667.     WriteCOMString := Ok;                        {- Return status-}
  668.   end;
  669. end;
  670. {****************************************************************************}
  671. Function CheckCOM(Nr : Byte; Var Ch : Char) : Boolean;
  672.  
  673. begin
  674.   With Ports[Nr] Do
  675.   begin
  676.     if InPtr <> OutPtr then                      {- Any Char in buffer ?-}
  677.     begin
  678.       Ch := Chr(Buf^[OutPtr]);                 {- Get Char from buffer-}
  679.       Inc(OutPtr);                             {- Count outPointer up-}
  680.       if OutPtr > BufSize then
  681.         OutPtr := 1;
  682.       CheckCOM := True;
  683.     end
  684.     else
  685.       CheckCOM := False;                         {- No Char in buffer-}
  686.   end;
  687. end;
  688. {****************************************************************************}
  689. Function COMError : Integer;
  690.  
  691. begin
  692.   COMError := COMResult;                           {- Return last error-}
  693.   COMResult := 0;
  694. end;
  695. {****************************************************************************}
  696. Function COMUsed(Nr : Byte) : Boolean;
  697.  
  698. begin
  699.   COMUsed := Ports[Nr].InUse;                      {- Return used status-}
  700. end;
  701. {****************************************************************************}
  702. Function IrqInUse(IrqNum : Byte) : Boolean;
  703.  
  704. Var
  705.   IrqOn : Byte;
  706.   Mask  : Byte;
  707.  
  708. begin
  709.   IrqInUse := False;
  710.  
  711.   if IrqNum In [0..7] then
  712.   begin
  713.     IrqOn := Port[$21];         {-1111 0100-}
  714.     Mask  := ($01 Shl IrqNum);
  715.     IrqInUse := IrqOn or not Mask = not Mask;
  716.   end;
  717. end;
  718. {****************************************************************************}
  719. Procedure SetIrqPriority(IrqNum : Byte);
  720.  
  721. begin
  722.   if IrqNum In [0..7] then
  723.   begin
  724.     if IrqNum > 0 then
  725.       Dec(IrqNum)
  726.     else IrqNum := 7;
  727.  
  728.     DisableInterrupts;
  729.     Port[PIC] := $C0 + IrqNum;
  730.     EnableInterrupts;
  731.   end;
  732. end;
  733. {****************************************************************************}
  734. Procedure ClearBuffer(Nr : Byte);
  735.  
  736. begin
  737.   With Ports[Nr] Do
  738.     if InUse and (BufSize > 0) then
  739.       OutPtr := InPtr;
  740. end;
  741. {****************************************************************************}
  742. Procedure DeInit;
  743.  
  744. Var
  745.   Count : Byte;
  746.  
  747. begin
  748.   For Count := 0 to 7 Do
  749.     CloseCOM(Count);          {- Close open ports-}
  750.  
  751.   DisableInterrupts;
  752.   Port[$21] := OldPort21;                          {- Restore PIC status-}
  753.   Port[$20] := $C7;                                {- IRQ0 1. priority-}
  754.   EnableInterrupts;
  755.  
  756.   ExitProc := ExitChainP;                          {- Restore ExitProc-}
  757. end;
  758.  
  759. {****************************************************************************}
  760. Procedure Init;
  761.  
  762. Var
  763.   Count : Byte;
  764.  
  765. begin
  766.   COMResult  := 0;
  767.   ExitChainP := ExitProc;                          {- Save ExitProc-}
  768.   ExitProc   := @DeInit;                           {- Set ExitProc-}
  769.  
  770.   For Count := 0 to 7 Do
  771.     Ports[Count].InUse := False;                   {- No ports open-}
  772.  
  773.   OldPort21 := Port[$21];                          {- Save PIC status-}
  774. end;
  775.  
  776. {****************************************************************************}
  777.  
  778. begin
  779.   Init;
  780. end.
  781.